home *** CD-ROM | disk | FTP | other *** search
- unit MyControl;
- {Splitbar Code Definition Function - ID=17}
- {This creates to types of splitbar controls - horizontal, variation code 1; and vertical, variation code 2}
- {A Splitbar is essentially just an indicator (thumb) which can be moved by the mouse to set }
- {up window panes. The control only moves the thumb. It is up to the application to create/resize normal}
- {scrollbars, adjust the content region, and so forth. It will only return the Indicator part code of}
- {inThumb (129). There are no page/line up/down parts}
- {valid min is 0 and max is screen width - indicatorwidth; control value is then in pixels}
- {To get a horizontal splitbar ask for CDEF 273 ( 16*ID + variation), and 274 for vertical}
- {History}
- {3/15/89 Created by Kirk Chase}
-
- interface
- { main entry into CDEF }
- function main (varCode: integer; theControl: ControlHandle; message: integer; param: longint): longint;
-
- implementation
- const
- vSplitBar = 2; {Variation code for a vertical splitbar}
- hSplitBar = 1; {Variation code for a horizontal splitbar}
- IndicatorWidth = 6; {width of thumb}
- PaneWidth = 4;
- draw = 1;
- erase = 0;
- invisible = 0;
- inactive = 255;
-
- function main;
-
- procedure doRect (varcode, value: integer; var theRect: rect);
- {calculate indicator rectangle according to varcode}
- begin
- {actual drawing of thumb is as follows for a horizontal splitbar - it is similar for a vertical one}
- { top := top of control + 1}
- {bottom := bottom of control -1}
- {left := value of control + left of control}
- {right := left + indicator width}
- case varcode of
- vSplitBar:
- begin
- theRect.top := value + theRect.top;
- theRect.bottom := theRect.top + IndicatorWidth;
- InsetRect(theRect, 1, 0);
- end;
- hSplitBar:
- begin
- theRect.left := value + theRect.left;
- theRect.right := theRect.left + IndicatorWidth;
- InsetRect(theRect, 0, 1);
- end;
- end;
- end;
-
- procedure doInit (myControl: ControlHandle);
- {initializes the control by storing the thumb region and setting the action proc to nil}
- begin
- myControl^^.contrlAction := nil; {set action proc - no default proc.}
- end; {of doInit}
-
- procedure doDraw (varCode: integer; myControl: ControlHandle; flag: integer);
- {this will draw or erase the thumb control according to flag}
- var
- aRect, iRect: Rect;
- oldClip, controlRegion: RgnHandle;
- oldPen: PenState;
- begin
- {only draw if visible}
- if (myControl^^.contrlVis <> invisible) then
- begin
- { Get the control's region and set the clip region to that region. }
- oldClip := NewRgn;
- GetClip(oldClip);
-
- { Set the clip region to the control's rectangle }
- aRect := myControl^^.contrlRect;
- iRect := aRect;
- controlRegion := NewRgn;
- RectRgn(controlRegion, aRect);
- MoveHHi(Handle(myControl));
- HLock(Handle(myControl));
- SetClip(controlRegion);
- HUnlock(Handle(myControl));
-
- {set pen to normal state}
- GetPenState(oldPen);
- PenNormal;
-
- FrameRect(aRect); {draw control bounds}
-
- doRect(varcode, myControl^^.contrlValue, iRect); {get indicator}
-
- {either draw or erase indicator}
- if flag = draw then
- PaintRect(iRect)
- else
- EraseRect(iRect);
-
- if (myControl^^.contrlHilite = inactive) then
- EraseRect(iRect); {inactive controls}
-
- SetClip(oldClip); {Clean up}
- DisposeRgn(oldClip);
- DisposeRgn(controlRegion);
- SetPenState(oldPen);
- end;
- end; {of doDraw}
-
- function doTest (varcode: integer; myControl: ControlHandle; theParam: longint): longint;
- {returns inThumb or 0 if mousedown in thumb or not}
- var
- CRect, IRect: Rect;
- thePoint: point;
- begin
- CRect := myControl^^.contrlRect; {initialize values}
- IRect := CRect;
- thePoint := point(theParam);
- doTest := 0;
-
- {test point if active and visible}
- if (myControl^^.contrlHilite <> inactive) and (myControl^^.contrlVis <> invisible) then
- begin
- {in control?}
- if PtInRect(thePoint, CRect) then
- begin
- {in thumb?}
- doRect(varcode, myControl^^.contrlValue, IRect); {get indicator}
- if PtInRect(thePoint, IRect) then
- doTest := inThumb;
- end;
- end;
- end; {of doTest}
-
- procedure doCalc (varcode: integer; myControl: ControlHandle; theParam: longint);
- {calculate all or indicator's region}
- var
- aRect: Rect;
- thumbRgn: RgnHandle;
- begin
- { CalcButtnRgn must first find out of the high bit is set. }
- { High bit set indicates that the region being calculated is for }
- { an indicator }
- if not BitTst(Ptr(@theParam), 0) then
- begin {whole region}
- theParam := longint(BitAnd(theParam, $00FFFFFF));
- aRect := myControl^^.contrlRect;
- RectRgn(RgnHandle(theParam), aRect);
- end
- else
- begin
- aRect := myControl^^.contrlRect; {get thumb region}
- doRect(varcode, myControl^^.contrlValue, aRect); {get indicator}
- thumbRgn := NewRgn;
- RectRgn(thumbRgn, aRect);
- if varcode = vSplitBar then {get region across screen}
- SetRect(aRect, 0, aRect.top + 1, aRect.right, aRect.bottom - 1) {vertical splitbar}
- else
- SetRect(aRect, aRect.left + 1, 0, aRect.right - 1, aRect.top); {horizontal splitbar}
- RectRgn(RgnHandle(theParam), aRect);
- UnionRgn(RgnHandle(theParam), thumbRgn, RgnHandle(theParam));
- DisposeRgn(thumbRgn);
- end;
- end; {of doCalc}
-
- procedure doThumb (myControl: ControlHandle; varcode: integer; theParam: longint);
- {this sets up dragging parameters for thumb}
- type
- thumbPtr = ^thumbinfo;
- thumbinfo = record
- limitRect: Rect;
- trackRect: Rect;
- axis: integer;
- end;
- begin
- with thumbPtr(theParam)^ do
- begin
- limitRect := myControl^^.contrlRect;
- trackRect := myControl^^.contrlRect;
- axis := varcode;
- end;
- end; {of doThumb}
-
- procedure doPosition (myControl: ControlHandle; varcode: integer; DeltaPoint: longint);
- {this routine is called to reposition the control }
- {first erase old position of control and draw in new place}
- var
- thePoint: point;
- value, delta, position: integer;
- aRect: rect;
- begin
- aRect := myControl^^.contrlRect; {get thumb region}
- doRect(varcode, myControl^^.contrlValue, aRect); {get indicator}
- InvalRect(aRect);
- doDraw(varCode, myControl, erase); {erase}
-
- thePoint := point(DeltaPoint);
- value := myControl^^.contrlValue;
-
- if varcode = vSplitBar then {calculate delta offset}
- begin
- position := value + thePoint.v;
- delta := thePoint.v;
- end
- else
- begin
- position := value + thePoint.h;
- delta := thePoint.h;
- end;
-
- {recalculate delta offset if out of bounds}
- if position < myControl^^.contrlMin then
- delta := -(value - myControl^^.contrlMin);
- if position > myControl^^.contrlMax then
- delta := myControl^^.contrlMax - value;
-
- myControl^^.contrlValue := myControl^^.contrlValue + delta; {reset control value}
-
- doDraw(varCode, myControl, draw); {redraw}
- end; {of doPosition}
-
- begin {main entry point}
- main := 0; {initialize values}
- case message of {switch to proper routine}
- initCntl:
- doInit(theControl);
-
- drawCntl:
- doDraw(varCode, theControl, draw);
-
- testCntl:
- main := doTest(varcode, theControl, param);
-
- { Calc the region for the button. }
- calcCRgns:
- doCalc(varcode, theControl, param);
-
- thumbCntl:
- doThumb(theControl, varcode, param);
-
- posCntl:
- doPosition(theControl, varcode, param);
-
- { Nothing to do for these messages... }
- dragCntl, autoTrack, dispCntl:
- ;
- otherwise
- end;
- end;
-
- end. {of MyControl Unit}